home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr53 / pctv4n_1.zip / ERRTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-10  |  3KB  |  109 lines
  1. { LISTING 2 : ERRTEST.PAS }
  2. UNIT ErrTest;
  3. INTERFACE
  4. USES
  5.   WinTypes,WinProcs,WObjects,WinDos,Strings,Error;
  6. TYPE
  7.   pErrorProneObject = ^tErrorProneObject;
  8.   tErrorProneObject = OBJECT(tObject)
  9.     Error: pError;
  10.     CONSTRUCTOR Init;
  11.     DESTRUCTOR Done; VIRTUAL;
  12.     PROCEDURE AttachErrorObject(NewError: pError);
  13.     PROCEDURE DoSomethingDangerous;
  14.   END;
  15.  
  16.   pErrorProneOwner = ^tErrorProneOwner;
  17.     tErrorProneOwner = OBJECT(tObject)
  18.     Error: pError;
  19.     ErrorProneObject: tErrorProneObject;
  20.     CONSTRUCTOR Init;
  21.     DESTRUCTOR Done; VIRTUAL;
  22.     PROCEDURE AttachErrorObject(NewError: pError);
  23.     PROCEDURE DoSomethingDangerous;
  24.   END;
  25. {===============================================================}
  26. IMPLEMENTATION
  27. {---------------- tErrorProneObject Methods --------------------}
  28. CONSTRUCTOR tErrorProneObject.Init;
  29. BEGIN
  30.   tObject.Init;
  31.   New(Error, Init (@Self, 'Error Prone Object'));
  32. END;
  33. {---------------------------------------------------------------}
  34. DESTRUCTOR tErrorProneObject.Done;
  35. BEGIN
  36.   IF (@Self = Error^.Owner) THEN Dispose(Error, Done);
  37.   tObject.Done;
  38. END;
  39. {---------------------------------------------------------------}
  40. PROCEDURE tErrorProneObject.AttachErrorObject(NewError: pError);
  41. BEGIN
  42.   IF (Error^.Owner = @Self) THEN Dispose(Error, Done);
  43.   Error := NewError;
  44. END;
  45. {---------------------------------------------------------------}
  46. PROCEDURE tErrorProneObject.DoSomethingDangerous;
  47.  
  48.   FUNCTION DoDangerousThing: Boolean;
  49.   BEGIN
  50.     DoDangerousThing := True;
  51.   END;
  52.  
  53. CONST
  54.   ERR_ThingFailed   = 100;
  55.   ERR_ThingFaltered = 101;
  56.  
  57. VAR Success: Boolean;
  58.  
  59. BEGIN
  60. {    When an object performs a dangerous task directly, and that
  61.   task fails,    it sets the error condition. }
  62.   IF (NOT DoDangerousThing) THEN BEGIN
  63.     Error^.SetError(ERR_ThingFailed, ERR_Severe, False, @Self);
  64.     Exit;
  65.   END;
  66. {    Some tasks, like writing to disk, may falter but (under
  67.   Windows) can be retried. }
  68.   REPEAT
  69.     Success := DoDangerousThing;
  70.     IF (NOT Success) THEN
  71.       Error^.SetError(ERR_ThingFaltered,ERR_Severe,True,@Self);
  72.   UNTIL (Success OR Error^.NoError(@Self));
  73. END;
  74. {---------------- tErrorProneOwner Methods ---------------------}
  75. CONSTRUCTOR tErrorProneOwner.Init;
  76. BEGIN
  77.   tObject.Init;
  78.   New (Error, Init(@Self, 'Error Prone Owner'));
  79.   ErrorProneObject.Init;
  80.   ErrorProneObject.AttachErrorObject(Error);
  81. END;
  82. {---------------------------------------------------------------}
  83. DESTRUCTOR tErrorProneOwner.Done;
  84. BEGIN
  85.   IF (@Self=Error^.Owner) THEN Dispose(Error, Done);
  86.   ErrorProneObject.Done;
  87.   tObject.Done;
  88. END;
  89. {---------------------------------------------------------------}
  90. PROCEDURE tErrorProneOwner.AttachErrorObject (NewError: pError);
  91. BEGIN
  92.   IF (Error^.Owner=@Self) THEN Dispose(Error, Done);
  93.   Error := NewError;
  94.   ErrorProneObject.AttachErrorObject(NewError);
  95. END;
  96. {---------------------------------------------------------------}
  97. PROCEDURE tErrorProneOwner.DoSomethingDangerous;
  98. BEGIN
  99.   ErrorProneObject.DoSomethingDangerous;
  100.   IF (ErrorProneObject.Error^.NoError(@Self)) THEN
  101.     (* Do other stuff *)
  102.   ELSE
  103.     (* Message will have been displayed IF @Self is still
  104.        Error owner; IF @Self is a property of yet another
  105.        object, message will not be displayed until
  106.        real owner checks for error. *)
  107. END;
  108. END.
  109.